Cours Genève 3

1. Préparatifs

J’installe ma session de travail

setwd("~/GitHub/Cours_2020_UniGE/Cours_Geneve_3")
monDossier="~/GitHub/Cours_2020_UniGE/Cours_Geneve_3"

library(reshape2)

Première chose à faire: importer le corpus. Il s’agit d’un csv, donc nous utilisons la fonction read.csv

theatre = "moliere_racine.tsv"
# le paramètre `header` permet de signaler que la première ligne contient le nom des colonnes
# le paramètre `sep` permet d'indiquer comment sont marquées les colonnes. La regex `\t` indique que nous utilisons des tabulations (notre fichier est donc en fait un `tsv`).
theatre <- read.csv(theatre, header=TRUE, sep = "\t", quote = '',fill = TRUE)

Je peux jeter un coup d’œil aux données brutes (on ne m’affiche que les première entrées de chaque colonne par commodité)

str(theatre)

'data.frame':   724 obs. of  8 variables:
 $ auteur     : Factor w/ 5 levels "\"MOLIERE, Jean-Baptiste Pocquelin dit (1622-1673) CORNEILLE, Pierre (1606-1684) QUINAULT, Philippe (1635-1688)\"",..: 2 2 2 2 2 2 2 2 2 2 ...
 $ titre      : Factor w/ 44 levels "\"ALEXANDRE LE GRAND, TRAGÉDIE.\"",..: 2 2 2 2 2 2 2 2 2 2 ...
 $ date       : Factor w/ 24 levels "\"1650\"","\"1655\"",..: 12 12 12 12 12 12 12 12 12 12 ...
 $ genre      : Factor w/ 6 levels "\"Comédie galante\"",..: 3 3 3 3 3 3 3 3 3 3 ...
 $ inspiration: Factor w/ 11 levels "\"bible\"","\"féérie\"",..: 10 10 10 10 10 10 10 10 10 10 ...
 $ structure  : Factor w/ 5 levels "\"Cinq actes\"",..: 3 3 3 3 3 3 3 3 3 3 ...
 $ type       : Factor w/ 3 levels "\"mixte\"","\"prose\"",..: 3 3 3 3 3 3 3 3 3 3 ...
 $ texteLemmat: Factor w/ 724 levels "\" à  bande  de  point  de  Hongrie  appliquer  fort  proprement  sur  un  drap  de  couleur  de  olive  avec  "| __truncated__,..: 629 169 339 272 673 144 82 333 9 306 ...

Je peux aussi les regarder dans un tableau directement dans RStudio. On remarque que les colonnes ont des noms: “auteur”, “titre”…

View(theatre)

Je peux sélectionner juste une colonne (ici “auteur”). Afin de ne pas tout afficher j’utilise head() pour ne montrer que les premières entrées:

head(theatre$auteur)

[1] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
[2] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
[3] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
[4] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
[5] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
[6] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
5 Levels: "MOLIERE, Jean-Baptiste Pocquelin dit (1622-1673) CORNEILLE, Pierre (1606-1684) QUINAULT, Philippe (1635-1688)" ...

# Je peux augmenter le nombre de résultat affiché en indiquant le chiffre souhaité de la manière suivante:
#head(theatre$auteur,10)
#Pour les dernières entrées, il existe une fonction `tail`
#tail(theatre$auteur)

Toutes les colonnes sont des métadonnées, sauf theatre$texteLemmat qui contient des morceaux de pièces de 1000 mots afin de simplifier le travail. Il va falloir transformer le contenu de cette colonne en matrice terme-document (Document Term Matrix): je crée un tableau avec une colonne pour chaque mot de mon corpus, et un rang par texte de mon corpus.

	mot1	mot2	mot3
Texte1	1	12	9
Texte2	1	154	4

#Je charge deux nouvelles librairies pour le _text mining_
if(!require("tm")){
  install.packages("tm")
  library("tm")
}
if(!require("tidytext")){
  install.packages("tidytext")
  library("tidytext")
}
corpus <- Corpus(VectorSource(theatre$texteLemmat), readerControl = list(language = "fr"))
corpus

<<SimpleCorpus>>
Metadata:  corpus specific: 1, document level (indexed): 0
Content:  documents: 724

ncol(as.matrix(DocumentTermMatrix(corpus)))

[1] 8896

2. Je nettoie mon corpus

Il est absolument fondamental de nettoyer mon corpus de travail. En effet: “pas” et “Pas” ne sont pas les mêmes chaînes de caractères (il y a une majuscule dans le second), et peut-être même pas les mêmes mots (adverbe ou substantif?). Je dois donc au moins retirer les majuscules (avec tolower()), ou même lemmatiser (de préférence avec un outil spécifique, qui n’existe pas dans R). Ici, nous fournissons le texte déjà lemmatisé pour simplifier le travail

2.1 Les stopwords

Comme notre objectif est d’avoir une approche thématique et conserver des mots potentiellement porteurs de sens: il faut donc retirer tous les mots les plus fréquents qui n’apportent, comme les les pronoms, les pronoms adverbiaux, les prépositions… Ces mots sont appelés des stopwords et une liste est fournie dans la fonction stopwords()

stopwords("french")

  [1] "au"       "aux"      "avec"     "ce"       "ces"      "dans"     "de"       "des"     
  [9] "du"       "elle"     "en"       "et"       "eux"      "il"       "je"       "la"      
 [17] "le"       "leur"     "lui"      "ma"       "mais"     "me"       "même"     "mes"     
 [25] "moi"      "mon"      "ne"       "nos"      "notre"    "nous"     "on"       "ou"      
 [33] "par"      "pas"      "pour"     "qu"       "que"      "qui"      "sa"       "se"      
 [41] "ses"      "son"      "sur"      "ta"       "te"       "tes"      "toi"      "ton"     
 [49] "tu"       "un"       "une"      "vos"      "votre"    "vous"     "c"        "d"       
 [57] "j"        "l"        "à"        "m"        "n"        "s"        "t"        "y"       
 [65] "été"      "étée"     "étées"    "étés"     "étant"    "suis"     "es"       "est"     
 [73] "sommes"   "êtes"     "sont"     "serai"    "seras"    "sera"     "serons"   "serez"   
 [81] "seront"   "serais"   "serait"   "serions"  "seriez"   "seraient" "étais"    "était"   
 [89] "étions"   "étiez"    "étaient"  "fus"      "fut"      "fûmes"    "fûtes"    "furent"  
 [97] "sois"     "soit"     "soyons"   "soyez"    "soient"   "fusse"    "fusses"   "fût"     
[105] "fussions" "fussiez"  "fussent"  "ayant"    "eu"       "eue"      "eues"     "eus"     
[113] "ai"       "as"       "avons"    "avez"     "ont"      "aurai"    "auras"    "aura"    
[121] "aurons"   "aurez"    "auront"   "aurais"   "aurait"   "aurions"  "auriez"   "auraient"
[129] "avais"    "avait"    "avions"   "aviez"    "avaient"  "eut"      "eûmes"    "eûtes"   
[137] "eurent"   "aie"      "aies"     "ait"      "ayons"    "ayez"     "aient"    "eusse"   
[145] "eusses"   "eût"      "eussions" "eussiez"  "eussent"  "ceci"     "cela"     "celà"    
[153] "cet"      "cette"    "ici"      "ils"      "les"      "leurs"    "quel"     "quels"   
[161] "quelle"   "quelles"  "sans"     "soi"     

Il existe des listes alternatives en ligne, plus complètes:

#Donner un nom au fichier que je télécharge
mesStops="stopwords-fr.csv"
#indiquer l'URL où se trouve le document à télécharger
stopword_enLigne = "https://raw.githubusercontent.com/stopwords-iso/stopwords-fr/master/stopwords-fr.txt"
#télécharger le fichier et l'enregistrer sous le nom que je viens de lui donner
download.file(stopword_enLigne,mesStops)

trying URL 'https://raw.githubusercontent.com/stopwords-iso/stopwords-fr/master/stopwords-fr.txt'
Content type 'text/plain; charset=utf-8' length 4566 bytes
==================================================
downloaded 4566 bytes

#Comme c'est un tableur, je le lis avec la fonction adéquat 
stopword_enLigne = read.csv(stopword_enLigne, header=FALSE, stringsAsFactors=FALSE)[,]
#je jette un coup d'œil aux 10 premiers
head(stopword_enLigne,10)

 [1] "a"          "abord"      "absolument" "afin"       "ah"         "ai"         "aie"       
 [8] "aient"      "aies"       "ailleurs"  

Je vais utiliser mes listes de stopwords l’une après l’autre pour nettoyer mon corpus. Pour cela j’utilise la fonction tm_map() qui permet de modifier les corpora. Dans ce cas précise j’utilise removeWords avec chacune des deux listes.

Malheureusement cette commande tm_map fonctionne mal, et il est préférable de nettoyer le texte “à l’ancienne”, en créant sa propore fonction.

#Je recharge mon corpus
corpus_clean <- tm_map(corpus_clean, PlainTextDocument)

transformation drops documents

#je crée une fonction a deux paramètres: le corpus d'entrée et la liste des stopwords.
removeStopWords <- function(corpus_a_nettoyer, stopwords_a_retirer){
  # je fais une boucle pour retirer chaque mot de ```stopwords_a_retirer```
  for (word in stopwords_a_retirer){
    #J'utilise une fonction anonyme (_snonymous function_) à un paramètre qui utilise la fonction ```gsub``` qui remplace le mot de ```stopwords_a_retirer``` par rien.
    removeWord <- function(x) gsub(paste("(^|\\s)(",word,") ", sep="")," ",x)
    #on retire le mot
    corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWord)
  }
  #Je renvoie le résultat
  return(corpus_a_nettoyer)
}
#Je passe mon ```corpus_clean``` comme ```corpus_a_nettoyer``` et mes ```stopword_enLigne``` comme ```stopwords_a_retirer```.
corpus_clean <- removeStopWords(corpus_clean, stopword_enLigne)

transformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documents

S’il reste des mots qui ne me plaisent pas, je peux continuer de les retirer en les mettant dans un vecteur

stopWords <- c( "à_le", "de_le", "-être", "faire", "falloir", "savoir", "pouvoir", "devoir", "devoir", "voir", "vouloir")
corpus_clean <- tm_map(corpus_clean, removeWords, stopWords)

transformation drops documents

inspect(corpus_clean[6])

<<SimpleCorpus>>
Metadata:  corpus specific: 1, document level (indexed): 0
Content:  documents: 1

[1] "  frayeur   âme blesser  moindre choc   entendre     horreur    pensée   jamais  consoler  coup   menacer   laurier   couronne  vainqueur  part     honneur suprême valoir    coûter  tendresse   cœur    moment trembler    aimer       feu   augmenter   marquer  œil  cœur  enflammer    avouer  chose charmant  trouver   amour   objet aimer    oser   scrupule  gêne  tendre sentiment         goûter  amour  Alcmène     entrer        ardeur       faveur   recevoir     qualité     époux  point    donner   nom pourtant   ardeur   brûler   droit  paraître  jour   comprendre   scrupule   embarrasser  amour       ardeur  tendresse passer    époux       moment  doux    délicatesse   concevoir point   cœur  amoureux   petit égard  attacher  étude     inquiétude  manière  heureux   charmant Alcmène    mari    amant  amant   toucher  franchement  sens     mari  gêne  amant   vœu jaloux   point souhaite     cœur  abandonner   passion   point    mari  donner     source obtenir  ardeur      nœud  hyménée    fâcheux    agir  coeur     jour    faveur  douceur empoisonner  scrupule   combattre    satisfaire  délicatesse    séparer    blesser   mari     vertu    cœur  bonté revêtir  amant   amour   tendresse amphitryon  vérité   moquer   langage   peur     croire  sage     écouter  discours  raisonnable Alcmène    penser    long séjour    coupable     port  moment presser adieu    étrange barbarie   temps  arracher    Alcmène       époux songer  amant   prier  séparer point   unir  dieu  époux  amant  fort précieux ciel   aimable caresse   époux ardemment chérir   traître  mari loin   tendresse  nuit    avertir    plier   voile   effacer  étoile  soleil   lit   sortir       quitte          acquitter   amphitryon  aller     brusquerie traître   séparer    fâcherie    temps ensemble demeurer   partir    brutal      douceur  régaler diantre      esprit  aller chercher  faribole  an  mariage épuiser     long temps    regarder traître amphitryon    Alcmène  étaler  flamme  rougir là-dessus    passion   témoigne   femme  Dieu cléantir   amant   âge   passer    seoir   commencement  vieux marier  mauvais grâce     attacher face face pousser  sentiment    perfide  espérer   cœur auprès  soupirer   garde     barbon  oser soupirer   crever  rire mérite  pendard  insigne bonheur     épouse  femme  honneur  Dieu     honnête  grand honneur  valoir   point  femme   rompre    tête   "

Je fais de nouveau une matrice “terme/document” (DTM, Document-term matrix). On se rappelle qu’il s’agit de créer une matrice (un tableau) avec une colonne pour chaque mot de mon corpus, et un rang par texte de mon corpus.

	mot1	mot2	mot3
Texte1	1	12	9
Texte2	1	154	4

dtm <- DocumentTermMatrix(corpus_clean)
rownames(dtm) <- theatre$genre

2.2 Les mots peu fréquents

Je peux désormais observer la fréquence des mots: je retrouve la loi de Zipf dans la distribution de mes données

freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Comme je vais dessiner un graph, j'ai besoin d'une nouvelle librairie: ```ggplot2```
if (!require("ggplot2")){
  install.packages("ggplot2")
  library("ggplot2")
}
#Je dessine mon graph
ggplot(freq, aes(x=frequence)) + geom_density()

Je peux compter les mots avec des fréquences faibles, par exemple avec moins de 100 occurrences

#Je retire tous les mots qui apparaissent entre 0 et 400 fois (on peut remplacer 400 par 100, ou même 10 si le corpus est trop gros)
motsPeuFrequents <- findFreqTerms(dtm, 0, 400)
length(motsPeuFrequents)

[1] 8550

head(motsPeuFrequents,50)

 [1] "admirer"     "agir"        "aile"        "aise"        "alcmène"     "allure"      "amoureux"   
 [8] "amphitryon"  "ardeur"      "arrêter"     "artifice"    "asseoir"     "aventure"    "aviser"     
[15] "badinage"    "beauté"      "besoin"      "bout"        "béotique"    "bête"        "cause"      
[22] "censeur"     "cesse"       "chaise"      "chaleur"     "changement"  "charmant"    "cheval"     
[29] "chérir"      "commander"   "comprendre"  "cruel"       "cygne"       "daigner"     "dame"       
[36] "decorum"     "descendre"   "destin"      "devenir"     "deviner"     "divinité"    "don"        
[43] "doucement"   "douceur"     "doute"       "doux"        "déguisement" "délicieux"   "désirer"    
[50] "emploi"     

Je peux aussi compter et afficher les mots les plus fréquents, par exemple avec plus de 400 occurrences

motsTresFrequents <- findFreqTerms(dtm, 401, Inf)
length(motsTresFrequents)

[1] 65

head(motsTresFrequents,50)

 [1] "aimer"     "aller"     "amour"     "attendre"  "chose"     "ciel"      "connaître" "coup"     
 [9] "croire"    "cœur"      "dieu"      "donner"    "foi"       "fort"      "gloire"    "homme"    
[17] "jamais"    "jour"      "mal"       "mettre"    "oui"       "passer"    "penser"    "plaire"   
[25] "point"     "prendre"   "seigneur"  "soin"      "sortir"    "trouver"   "venir"     "âme"      
[33] "œil"       "affaire"   "esprit"    "grand"     "honneur"   "madame"    "monde"     "monsieur" 
[41] "mort"      "nom"       "porter"    "raison"    "temps"     "chercher"  "entendre"  "lieu"     
[49] "main"      "perdre"   

Je fais un très grand ménage, avec une fonction que je crée pour retirer les mots les moins fréquents:

#Je crée une fonction ```grandMenage```
grandMenage <- function(corpus_a_nettoyer, mots_peu_importants){
  #Afin de simplifier le travail (de mon ordinateur), je vais rassembler les mots à retirer en groupe 500 tokens, que je vais traiter séparément.
    chunk <- 500
    #Je compte le nombre de mots à retirer
    n <- length(mots_peu_importants)
    #Je compte les groupes de 500 (ici 17.05), j'arrondis au plus petit entier supérieur (ici 18) 
    r <- rep(1:ceiling(n/chunk),each=chunk)[1:n]
    #Je constitue mes lots sur la base du décompte précédemment mentionné
    d <- split(mots_peu_importants,r)
    #Je fais une boucle: pour retirer les mots du corpus, morceau par morceau
    for (i in 1:length(d)) {
        corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWords, c(paste(d[[i]])))
    }
    #Je renvoie un résultat
    return(corpus_a_nettoyer)
}
# J'utilise ma fonction avec ```corpus_clean``` comme ```corpus_a_nettoyer``` et ```motsPeuFrequents``` comme ```mots_peu_importants```
corpus_clean <- grandMenage(corpus_clean, motsPeuFrequents)

transformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documentstransformation drops documents

Je redéfinis ma matrice à partir de mon nouveau corpus

dtm <- DocumentTermMatrix(corpus_clean)
rownames(dtm) <- theatre$genre
freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Je fais un petit graph
ggplot(freq, aes(x=frequence)) + geom_density()

Je nettoye un peu ma DTM pour éliminer les rangs vides

rowTotals <- apply(dtm , 1, sum)      #Find the sum of words in each Document
dtm_clean   <- dtm[rowTotals> 0, ]    #remove all docs without words

3. Topic modeling

Remarque préliminaire: le topic modeling requiert des (très) grands corpus, si possible en centaines de documents. Pas de panique cependant: une manière de les obtenir est de diviser chaque textes en plusieurs documents qui forment une unité sémantique. Par exemple le chapitre, la scène, le paragraphe, ou bien (comme c’est le cas pour notre exercice) de 1000 mots.

3.1 Explication théorique

Un thème (topic) est un clusters de mots, i.e. une récurrence de co-occurrence.

100% center

Source: Wikisource

Le principe du topic modeling est proche de celui de surligner un texte avec plusieurs couleurs: une pour chaque sujet, thème ou topic.

100% center

Une telle image soulève deux questions sur lesquelles nous reviendront plus tard: * un article peut-il contenir plusieurs sujets? * un mot peut-il n’appartenir qu’à un seul sujet?

Afin de reconnaître ces sujets, on va recourir à une allocation de Dirichlet latente ( Latent Dirichlet allocation, LDA). * C’est une approche non supervisée, c’est-à-dire qu’elle ne nécessite pas d’annotation préalable de données. * Il nous faut définir à l’avance un nombre de sujets/thèmes (infra la variable k)

Le LDA est modèle génératif probabiliste permettant d’expliquer des ensembles d’observations, par le moyen de groupes non observés, eux-mêmes définis par des similarités de données.

150% center

Source: wikipedia

Dans ce graph: * M est le nombre de documents (corpus) * N est le nombre de mots (document) * W est un mot observé

La partie latente (cachée): * Z est un topic attribué à un w * θ est le mélange des topics à l’échelle du document

Deux paramètres pour la distribution * α est la distribution par document. Si sa valeur est élevée, le document tend à contenir plusieurs topics, si la valeur est faible le nombre de topics est limité * β est la distribution par topic. Si sa valeur est élevée, un même mot se retrouve dans plusieurs topics (qui se ressemblent donc), si la valeur est faible les similarités entre les topics est faible

150% center

Source: wikipedia

3.2 Une LDA

Le modèle va classer aléatoirement tous les mots en n sujets, et tenter d’affiner cette répartition de manière itérative en observant les contextes:

#J'installe une nouvelle librairie pour le _topic modeling_
if(!require("topicmodels")){
  install.packages("topicmodels")
  library("topicmodels")
}
#Je vais partir sur une classification en deux _topics_
k = 2
lda_2 <- LDA(dtm_clean, k= k, control = list(seed = 1234))
##Je tente avec trois, pour voir…
lda_3 <- LDA(dtm_clean, k= k+1, control = list(alpha = 0.1))

Le résultat produit est une matrice avec pour chaque mot la probabilité qu’il appartienne à un des différents topics. On donne un score β, qui est celui présenté infra.

topics <- tidy(lda_2, matrix = "beta")
topics

3.3 Les paramètres de Gibbs

Les paramètres de Gibbs permettent une sophistication du système précédent. C’est une probabilité conditionnelle qui s’appuie, pour calculer le β d’un mot, sur le β des mots voisins. Pour ce faire nous devons déterminer: 1. À quel point un document aime un topic 2. À quel pount un topic aime un mot

Un document:

Voiture	Autoroute	Musique	Vélo	Vacances
1	??	2	1	3

Sachant que le décompte est le suivant

	topic 1	topic 2	topic 3
Voiture	34	49	75
Autoroute	150	50	70
Musique	34	4	170
Vélo	543	2	150
Vacances	23	70	563

Le topic 1 est le plus représenté dans le document, et Autoroute est déjà surreprésenté dans le décompte, donc on update le tout

Voiture	Autoroute	Musique	Vélo	Vacances
1	1	2	1	3

	topic 1	topic 2	topic 3
Voiture	34	49	75
Autoroute	151	50	70
Musique	34	4	170
Vélo	543	2	150
Vacances	23	70	563

## Set parameters for Gibbs sampling
#Le modèle va tourner 2000 fois avant de commencer à enregistrer les résultats
burnin <- 2000
#Après cela il va encore tourner 2000 fois
iter <- 2000
# Il ne va enregistrer le résultat que toutes les 500 itérations
thin <- 500
#seed et nstart pour la reproductibilité
SEED=c(1, 2, 3, 4, 5)
seed <-SEED
nstart <- 5
#Seul meilleur modèle est utilisé
best <- TRUE
#2 topics
lda_gibbs_2 <- LDA(dtm_clean, k, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))
#3 topics
lda_gibbs_3 <- LDA(dtm_clean, k+1, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))

Je peux désormais voir les premiers résultats pour chacun des modèles. Il s’agit de de mots dont la fréquence d’utilisation est corrélée

"LDA 2"

[1] "LDA 2"

termsTopic <- as.data.frame(terms(lda_2,10))
head(termsTopic,11)

    Topic 1  Topic 2
1     venir    point
2  monsieur    aller
3     point     cœur
4   prendre    amour
5     aller   donner
6    madame monsieur
7     homme   croire
8    jamais    chose
9       œil   mettre
10     père      oui

"LDA 3"

[1] "LDA 3"

termsTopic <- as.data.frame(terms(lda_3,10))
head(termsTopic,11)

    Topic 1  Topic 2  Topic 3
1  monsieur     fils     cœur
2     point    aller    point
3     aller     dieu    amour
4     venir   madame    aimer
5     chose     sang      œil
6       oui seigneur    aller
7    donner     père seigneur
8   prendre    point    venir
9     homme      œil   madame
10     fort      roi   croire

"LDA GIBBS 2"

[1] "LDA GIBBS 2"

termsTopic <- as.data.frame(terms(lda_gibbs_2,10))
head(termsTopic,11)

    Topic 1  Topic 2
1     point     cœur
2  monsieur   madame
3     aller    amour
4     venir      œil
5    donner    aimer
6   prendre seigneur
7       oui     dieu
8     chose     ciel
9   trouver     jour
10    homme   croire

"LDA GIBBS 3"

[1] "LDA GIBBS 3"

termsTopic <- as.data.frame(terms(lda_gibbs_3,10))
head(termsTopic,11)

   Topic 1  Topic 2  Topic 3
1    point monsieur seigneur
2     cœur    aller     dieu
3   madame      oui      œil
4   croire   donner     fils
5    venir    chose    aller
6    aimer  prendre     main
7    amour    homme     jour
8   jamais  trouver      roi
9      âme     fort     père
10   grand    venir attendre

Nous allons utiliser lda_gibbs_2 et construire une matrice avec les β des tokens (pour les ɣ, et donc des probabilités par document, on aurait mis matrix = "gamma"). Chaque token est répété deux fois, avec une probabilité pour chaque topic:

topics <- tidy(lda_gibbs_2, matrix = "beta")
topics

4. Visualisation

#Je vais encore solliciter une nouvelle librairie
if (!require("dplyr")){
   install.packages("dplyr")
  library("dplyr")
}
#Je récupère mes mots
top_terms <- topics %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup()  %>%
  arrange(topic, -beta)
#Je fais un graph
top_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) + geom_col(show.legend = FALSE) +
                                                  facet_wrap(~ topic, scales = "free") +
                                                  coord_flip() +
                                                  scale_x_reordered()

Je vais désormais associer chaque mot à l’un des 5 genres possibles, pour déterminer auquel mes tokens sont rattachés, et découvrir (potentiellement quel genre se cacher derrière quel topic

if (!require("reshape2")){
  install.packages("reshape2")
  library("reshape2")
}
df <- melt(as.matrix(dtm_clean))
df <- df[df$Terms %in% findFreqTerms(dtm_clean, lowfreq = 800), ]
ggplot(df, aes(as.factor(Docs), Terms, fill=log(value))) +
                                             geom_tile() +
                                             xlab("Genres") +
                                             scale_fill_continuous(low="#FEE6CE", high="#E6550D") +
                                             theme(axis.text.x = element_text(angle=90, hjust=1))

tt <- posterior(lda_gibbs_2)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])
colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) + 
                                              geom_tile() +
                                              theme(text = element_text(size=35))

tt <- posterior(lda_gibbs_3)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])
colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) + 
                                              geom_tile() +
                                              theme(text = element_text(size=35))

DocumentTopicProbabilities <- as.data.frame(lda_gibbs_2@gamma)
rownames(DocumentTopicProbabilities) <- rownames(corpus_clean)
head(DocumentTopicProbabilities)

         V1        V2
1 0.4786325 0.5213675
2 0.5083333 0.4916667
3 0.5433071 0.4566929
4 0.5619835 0.4380165
5 0.5357143 0.4642857
6 0.4545455 0.5454545

Nous allons désormais faire des word clouds. Pour cela appelons (installons?) les libraries suivantes:

if (!require("wordcloud")){
   install.packages("wordcloud")
  library("wordcloud")
}
if (!require("RColorBrewer")){
   install.packages("RColorBrewer")
  library("RColorBrewer")
}
if (!require("wordcloud2")){
   install.packages("wordcloud2")
  library("wordcloud2")
}

je récupère les mots et je les associe à leur 𝛃

tm <- posterior(lda_gibbs_2)$terms
data = data.frame(colnames(tm))
head(data)

  colnames.tm.
1        aimer
2      alcmène
3        aller
4        amour
5     attendre
6        chose

Je produis une visualisation par topic

for(topic in seq(k)){
    data$topic <-tm[topic,]
    #text(x=0.5, y=1, paste("V",topic, sep=""),cex=0.6)
    wordcloud(
      words = data$colnames.tm.,
      freq = data$topic,
      #sous ce seuil, les mots ne seront pas affichés
      min.freq=0.0002,
      #nombre maximum de mots à afficher
      max.words=30,
      #Si faux, en ordre croissant
      random.order=FALSE,
      #% de mots à 90°
      rot.per=.35,
      #taille du graph
      scale=c(10,10),
      #couleurs
      colors = brewer.pal(5, "Dark2")
      # il est possible de rentrer directement les couleurs qui nous intéressent
      #c("red", "blue", "yellow", "chartreuse", "cornflowerblue", "darkorange")
    )
}

Finissons avec un peu de mauvais goût, grâce au package wordcloud2

wordcloud2(data = data,
          size=0.4,
          color= "random-light",
          backgroundColor = "pink",
          shape = 'star',
          rotateRatio=1
    )

Rermerciements

Les données d’entraînement ont été créées par JB Camps (ENC). Des morceaux de ce script (notamment pour le nettoyage des données) proviennent d’un cours de Mattia Egloff (UniL).